
(* Dimensions d'une image *)
let get_dims img =
  ((Sdlvideo.surface_info img).Sdlvideo.w, (Sdlvideo.surface_info img).Sdlvideo.h)
 
(* init de SDL *)
let sdl_init () =
  begin
    Sdl.init [`EVERYTHING];
    Sdlevent.enable_events Sdlevent.all_events_mask;
  end
 
(* attendre une touche ... *)
let rec wait_key () =
  let e = Sdlevent.wait_event () in
    match e with
    Sdlevent.KEYDOWN _ -> ()
      | _ -> wait_key ()
 
(*
  show img dst
  affiche la surface img sur la surface de destination dst (normalement l'écran)
*)
let show img dst =
  let d = Sdlvideo.display_format img in
    Sdlvideo.blit_surface d dst ();
    Sdlvideo.flip dst


type point =
    {
      x : int;
      y : int;
    }

type carre =
    {
      sommet : point*point*point*point;
    }

type triangle = {p1:point; p2:point; p3:point}

let insert_color color l =
  let rec aux color = function
      [] -> color::[]
    | e::l when (e = color) -> l
    | e::l -> e::(aux color l)
  in
aux color l

let carre_plein carre img pas =
  let (a, b, c, d) = carre.sommet in
  if (b.x - a.x > pas) then
    begin
      let bool1 = ref true in
      let ay = ref a.y in
      while  (!bool1)&&(!ay <= d.y) do
	let ax = ref a.x in
	while (!bool1)&&(!ax <= b.x) do
	  ax := !ax + 1;
	  let color2 = (Sdlvideo.get_pixel_color img !ax !ay) in
	  if (color2 = Sdlvideo.black) then
	    bool1 := false    
	done;
	ay := !ay + 1
      done;
      !bool1
    end
  else
    true
      
let milieu a b = 
  let x = (a.x + b.x) / 2 in
  let y = (a.y + b.y) / 2 in
  {x = x; y = y}

let milieu_carre carre =
  let (a, b, c, d) = carre.sommet in
  let mid = milieu a b in
  let mid2 = milieu a d in
  {x = mid.x; y = mid2.y}

let id carre1 carre2 =
  let (a, b, c, d) = carre1.sommet in
  let (e, f, g, h) = carre2.sommet in
  (a = e) && (b = f) && (c = g) && (d = h)

let delete carre l =
  let rec aux test = function
      [] -> []
    | e::l when (id e test) -> l
    | e::l -> e::(aux test l) in
  l := aux carre !l;
  !l

let divise_carre carre liste_c =
  let (a, b, c, d) = carre.sommet in
  let mid = milieu_carre carre in
  let mid1 = milieu a b in
  let mid2 = milieu b c in
  let mid3 = milieu c d in
  let mid4 = milieu d a in
  let carre1 = {sommet = (a, mid1, mid, mid4)} in
  let carre2 = {sommet = (mid1, b, mid2, mid)} in
  let carre3 = {sommet = (mid, mid2, c, mid3)} in
  let carre4 = {sommet = (mid4, mid, mid3, d)} in
  liste_c := delete carre liste_c;
  let liste = carre1::carre2::carre3::carre4::[] in
  liste_c := liste@(!liste_c);
  liste

let init_all img liste_c =
  let (w, h) = ((Sdlvideo.surface_info img).Sdlvideo.w, (Sdlvideo.surface_info img).Sdlvideo.h) in
  let p1 = {x=0; y=0} in
  let p2 = {x=w; y=0} in
  let p3 = {x=w; y=h} in
  let p4 = {x=0; y=h} in
  let carre = {sommet = (p1, p2, p3, p4)} in
  liste_c := carre::!liste_c;
  !liste_c
      
let rec quadtree_boucle carre_base liste_c img pas =
  let rec testo liste_c img = function
      [] -> ()
    | e::l ->
	begin
	  let (a, b, c, d) = e.sommet in
	  quadtree_boucle e liste_c img pas;
	  testo liste_c img l
	end
  in
  if not(carre_plein carre_base img pas) then
    begin
      let l = (divise_carre carre_base liste_c) in
      testo liste_c img l;
    end;
  !liste_c
 
let quadtree img pas =
  let liste_c = ref [] in
  liste_c := init_all img liste_c;
  liste_c := quadtree_boucle (List.nth !liste_c 0) liste_c img pas;
  !liste_c

let draw_droite_hori a b img =
  for i = a.x to b.x do
    Sdlvideo.put_pixel_color img i a.y (255, 255, 0)
  done

let draw_droite_vert b c img =
    for i = b.y to c.y do
      Sdlvideo.put_pixel_color img b.x i  (255, 255, 0)
    done

let draw_carre carre img = 
  let (a, b, c, d) = carre.sommet in
  draw_droite_hori a b img;
  draw_droite_hori d c img;
  draw_droite_vert b c img;
  draw_droite_vert a d img

let draw_quadtree liste_c img =
  for i = 0 to (List.length liste_c) - 1 do
    draw_carre (List.nth liste_c i) img
  done

 let rec elt (i,l) = match (i,l) with
     (_,[]) -> failwith "depassement de limite"
   | (0,e::l) -> e
   | (_,e::l1) -> elt(i-1,l1)

let rec parse_hauteur l1 l2 = function
     [] -> (l1,l2)
   | (h,r,g,b)::l -> parse_hauteur (((r),(g),(b))::l1) (h::l2) l 

(*cree liste de couleur avec sa hauteur pour avoir la hauteur des couleurs*)
let height_of_color (r,g,b) fileparse =
   begin
     let listeh = snd(fileparse) in
       (*liste de couleurs*)
     let listec = fst(fileparse) in
     let h = ref 0 in
       for i = 0 to ((List.length listec)-1) do
	 if (r,g,b) = elt (i,listec) then
	   h := elt(i,listeh);
       done;      
       !h;	
   end 

 let rec doublons x = function
     [] -> false
   |e::l when x = e -> true
   |e::l -> doublons x l

 let rec tri = function
     [] -> []
   |e::l -> if (doublons e l) then (tri l) else e::(tri l)

 let rec cherche_ds_liste n e = function
     [] -> n
   |e1::l when e1 = e -> n
   |e1::l -> cherche_ds_liste (n+1) e l

let rec liste_trois_to_un = function
     [] -> []
   |t::l -> t.p1::(t.p2::(t.p3::(liste_trois_to_un l)))

let quadtree_obj ltriangle img listecouleur =
   begin
     let file = open_out "triangulation.obj" in
     let l1 = liste_trois_to_un ltriangle in
     let l2 = tri l1 in
     let n = ref 0 in
     let fileparse = parse_hauteur [] [] listecouleur in
     let f p = let zozo1=(p.x) and zozo2=(p.y) in output_string file ("v" ^ " " ^
						     string_of_int(zozo1) ^
						     "." ^
						     " " ^
						     string_of_int(zozo2) ^
						     "." ^
						     " " ^ 
						     string_of_int(height_of_color (Sdlvideo.get_pixel_color img (zozo1) (zozo2)) fileparse) ^
						     "." ^ "\n" ) in
       output_string file ("g triangulation.obj" ^ "\n" ^ "\n" );
       List.iter f l2;
       output_string file ("\n");
       while !n <= (List.length l1) - 3 do
	 output_string file ("f" ^ " " ^ string_of_int(cherche_ds_liste 1 (List.nth l1 !n) l2) ^ "//" ^ " " ^
			     string_of_int (cherche_ds_liste 1 (List.nth l1 (!n+1)) l2) ^ "//" ^ " " ^
			     string_of_int (cherche_ds_liste 1 (List.nth l1 (!n+2)) l2) ^ "//" ^ "\n");
	   n := !n+3
	   
       done;
       close_out file;	        
   end

let rec makegoodliste = function
    [] -> []
  |e::l -> let (a, b, c, d) = e.sommet in {p1=a;p2=b;p3=c}::({p1=a;p2=d;p3=c}::(makegoodliste l))

(* main *)
let main src img dst listecouleur pas quadrillage_ou_point_obj() =
  begin
    (* Initialisation de SDL *)
    sdl_init ();
    (* Chargement d'une image *)
    let img = Sdlloader.load_image img in
    let img2 = Sdlloader.load_image src in
    let n = quadrillage_ou_point_obj in
    let listecarre = quadtree img (pas+1) in
    let listetriangle = makegoodliste listecarre in
    draw_quadtree listecarre img;
    Sdlvideo.save_BMP img dst;
    if (n = 1) then
      quadtree_obj listetriangle img2 listecouleur;
  end
